PC Format 25/PCFormat 1993-10.iso/READER.ZIP/SPREDIT.BAS

BASIC Source File | 1993-05-29 | 6.2 KB | 345 lines

DECLARE SUB mb ()
DECLARE SUB writ ()
DECLARE SUB red ()
DECLARE SUB daw ()
DECLARE SUB link ()
DECLARE SUB menu ()
DECLARE SUB sinit ()
DECLARE SUB co (c2)
COMMON SHARED s, c, c1, c2, c3, c4, c5, nkpf, f, x1, y1, px1, px2, py1, py2
DIM SHARED block(250)
DIM SHARED bck(250)
DIM SHARED store(30, 20, 25) AS INTEGER
DIM SHARED sprite(5000)
DIM SHARED vblock(30, 20) AS INTEGER
DIM SHARED sh(500)
DIM SHARED svx(2) AS INTEGER
DIM SHARED svy(2) AS INTEGER
KEY(1) OFF
KEY(11) OFF
KEY(12) OFF
KEY(13) OFF
KEY(14) OFF
SCREEN 0
PRINT "Sprite Editor, by Sam Smith. (c) 1993. Copy and alter freely but do not remove"; "this message."
DO UNTIL INKEY$ <> ""
LOOP
menu
END
1
IF c1 > 1 THEN CALL co(-1)
RETURN
2
IF c1 < 6 THEN CALL co(1)
RETURN
md: DATA "1. Make Block.","2. Save Blocks.","3. Load Blocks.","4. Draw Blocks.","5. Store Sprite In File.","6. Quit."
5
LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
IF y1 > 1 THEN y1 = y1 - 1
RETURN
6
LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
IF x1 > 1 THEN x1 = x1 - 1
RETURN
7
LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
IF x1 < 30 THEN x1 = x1 + 1
RETURN
8
LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
IF y1 < 20 THEN y1 = y1 + 1
RETURN
9
LOCATE 1, 5
INPUT "Enter Colour:", c4
RETURN
10
PUT (x1, y1), bck(1), PSET
IF y1 > 5 THEN y1 = y1 - 4
GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
PUT (x1, y1), block(1), OR
RETURN
11
PUT (x1, y1), bck(1), PSET
IF x1 > 5 THEN x1 = x1 - 4
GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
PUT (x1, y1), block(1), OR
RETURN
12
PUT (x1, y1), bck(1), PSET
IF x1 < 635 THEN x1 = x1 + 4
GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
PUT (x1, y1), block(1), OR
RETURN
13
PUT (x1, y1), bck(1), PSET
IF y1 < 315 THEN y1 = y1 + 4
GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
PUT (x1, y1), block(1), OR
RETURN
14
LINE (x1, y1)-(x1, y1), c5
y1 = y1 - 3
c5 = POINT(x1, y1)
LINE (x1, y1)-(x1, y1), 15
RETURN
15
LINE (x1, y1)-(x1, y1), c5
x1 = x1 - 3
c5 = POINT(x1, y1)
LINE (x1, y1)-(x1, y1), 15
RETURN
16
LINE (x1, y1)-(x1, y1), c5
x1 = x1 + 3
c5 = POINT(x1, y1)
LINE (x1, y1)-(x1, y1), 15
RETURN
17
LINE (x1, y1)-(x1, y1), c5
y1 = y1 + 3
c5 = POINT(x1, y1)
LINE (x1, y1)-(x1, y1), 15
RETURN

SUB co (c2)
COLOR 15
IF c1 = 6 AND c2 = 1 THEN GOTO fs
IF c1 = 1 AND c2 = -1 THEN GOTO fs
c1 = c1 + c2
IF c2 = -1 THEN GOSUB 3 ELSE GOSUB 4
RESTORE md
FOR cou = 1 TO c1
READ c$
NEXT cou
LINE (63, 85 + (c1 * 14))-(65 + (LEN(c$) * 9), 97 + (c1 * 14)), 1, BF, 1
GET (63, 85 + (c1 * 14))-(65 + (LEN(c$) * 9), 97 + (c1 * 14)), sh(1)
LOCATE 7 + c1, 10
PRINT c$
PUT (63, 85 + (c1 * 14)), sh(1), XOR
GOTO fs
3
RESTORE md
FOR cou = 1 TO 6
READ c$
IF cou = c1 + 1 THEN LOCATE 7 + cou, 8 ELSE GOTO el
PRINT " " + c$ + "    "
el:
NEXT cou
RETURN
4
RESTORE md
FOR cou = 1 TO 6
READ c$
IF cou = c1 - 1 THEN LOCATE 7 + cou, 8 ELSE GOTO el1
PRINT " " + c$ + "    "
el1:
NEXT cou
RETURN
fs:
END SUB

SUB daw
CLS
INPUT f$
PUT (px1 + 1, py1 + 1), sprite(1), XOR
OPEN f$ FOR OUTPUT AS #1
PRINT #1, px1
PRINT #1, px2
PRINT #1, py1
PRINT #1, py2
FOR c = px1 TO px2
FOR c2 = py1 TO py2
PRINT #1, POINT(c, c2)
NEXT c2
NEXT c
CLOSE #1
CLS
PUT (0, 0), sprite(1), XOR
a$ = ""
DO UNTIL a$ <> ""
a$ = INKEY$
LOOP
END SUB

SUB link
CLS
KEY(1) ON
KEY(12) ON
KEY(13) ON
ON KEY(11) GOSUB 10
ON KEY(12) GOSUB 11
ON KEY(13) GOSUB 12
ON KEY(14) GOSUB 13
s = 1
DO UNTIL s = 0
INPUT "Enter Slot: ", s
FOR c = 1 TO 250
bck(c) = 0
block(c) = 0
NEXT c
FOR x1 = 1 TO 30
FOR y1 = 1 TO 20
LINE (x1, y1)-(x1, y1), store(x1, y1, s)
NEXT y1
NEXT x1
x1 = 1
x2 = 1
GET (1, 1)-(30, 20), block(1)
LINE (0, 0)-(640, 50), 0, BF
GET (1, 1)-(30, 20), bck(1)
LOCATE 1, 1
i$ = ""
DO UNTIL i$ = "E"
LOCATE 1, 1
PRINT "X: "; x1; "."
PRINT "Y: "; y1; "."
i$ = INKEY$
LOOP
LOOP
ON KEY(11) GOSUB 14
ON KEY(12) GOSUB 15
ON KEY(13) GOSUB 16
ON KEY(14) GOSUB 17
FOR c = 1 TO 2
a$ = ""
x1 = 50
y1 = 50
c5 = POINT(x1, y1)
LINE (x1, y1)-(x1, y1), 15
DO UNTIL a$ <> ""
LOCATE 1, 1
PRINT "X: "; x1; "."
PRINT "Y: "; y1; "."
a$ = INKEY$
LOOP
svx(c) = x1
svy(c) = y1
NEXT c
GET (svx(1) + 1, svy(1) + 1)-(svx(2) - 1, svy(2) - 1), sprite(1)
px1 = svx(1)
py1 = svy(1)
px2 = svx(2)
py2 = svy(2)
KEY(12) OFF
KEY(13) OFF
END SUB

SUB mb
KEY(1) ON
KEY(12) ON
KEY(13) ON
ON KEY(11) GOSUB 5
ON KEY(12) GOSUB 6
ON KEY(13) GOSUB 7
ON KEY(14) GOSUB 8
ON KEY(1) GOSUB 9
CLS
INPUT "Enter slot:", s
CLS
FOR x1 = 1 TO 30
FOR y1 = 1 TO 20
vblock(x1, y1) = store(x1, y1, s)
c3 = vblock(x1, y1)
LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
LINE (x1, y1)-(x1, y1), store(x1, y1, s)
NEXT y1
NEXT x1
f = 0
x1 = 1
y1 = 1
DO UNTIL f = -1
c3 = vblock(x1, y1)
LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), 15, BF
LINE (x1, y1)-(x1, y1), vblock(x1, y1)
i$ = INKEY$
IF i$ = "E" THEN f = -1
IF i$ = CHR$(13) THEN vblock(x1, y1) = c4
LOOP
KEY(1) OFF
KEY(12) OFF
KEY(13) OFF
INPUT "Enter slot:", s
FOR x1 = 1 TO 30
FOR y1 = 1 TO 20
store(x1, y1, s) = vblock(x1, y1)
NEXT y1
NEXT x1
END SUB

SUB menu
SCREEN 9
ndr:
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB 1
ON KEY(14) GOSUB 2
CLS
LINE (0, 0)-(600, 330), 10, B
RESTORE md
FOR cob = 1 TO 6
READ a$
LOCATE 7 + cob, 10
PRINT a$
NEXT cob
LOCATE 5, 8
COLOR 14
PRINT "Options."
LINE (50, 72)-(123, 72), 9
CALL sinit
f = 0
c1 = 1
DO UNTIL f = -1
i$ = INKEY$
IF i$ = CHR$(13) THEN f = -1
LOOP
IF c1 = 6 THEN GOTO em
IF c1 = 1 THEN CALL mb
IF c1 = 4 THEN CALL link
KEY(11) OFF
KEY(14) OFF
IF c1 = 2 THEN CALL writ
IF c1 = 3 THEN CALL red
IF c1 = 5 THEN daw
GOTO ndr:
em:
END SUB

SUB red
CLS
INPUT "Enter Filename: ", f$
OPEN f$ FOR INPUT AS #1
FOR x1 = 1 TO 30
FOR y1 = 1 TO 20
FOR s = 0 TO 25
INPUT #1, store(x1, y1, s)
NEXT s
NEXT y1
NEXT x1
CLOSE #1
END SUB

SUB sinit
FOR c = 1 TO 6
CALL co(1)
NEXT c
FOR c = 1 TO 5
CALL co(-1)
NEXT c
END SUB

SUB writ
CLS
INPUT "Enter Filename: ", f$
OPEN f$ FOR OUTPUT AS #1
FOR x1 = 1 TO 30
FOR y1 = 1 TO 20
FOR s = 0 TO 25
PRINT #1, store(x1, y1, s)
NEXT s
NEXT y1
NEXT x1
CLOSE #1
END SUB